REBOL [
	Title: "RebGUI edit feel"
	Owner: "Ashley G Truter"
	Purpose: "Edit support for RebGUI widgets."
	Acknowledgements: {
		Edit functionality based on the work of Carl Sassenrath (%view-edit.r SDK source)
		Undo/Redo based on the work of Romano Paolo Tenca http://www.rebol.it/~romano/edit-text-undo.txt
		Soundex function derived from Allen Kamp's http:ne//www.rebol.org/library/scripts-download/soundex.r
		Dictionaries sourced from AbiWord http://www.abisource.com/downloads/dictionaries/Windows/
		Spell-check based on code in this thread: http://www.rebol.org/ml-display-thread.r?m=rmlNYQC
	}
]

edit: make object! [

	siblings: none
	caret: none

	letter: make bitset! [#"A" - #"Z" #"a" - #"z" #"'"]
	capital: make bitset! [#"A" - #"Z"]
	other: negate letter

	;
	;	--- Spellcheck ---
	;

	edits: make function! [
		words [block!]
		/local result ln w
	] [
		result: copy []
		foreach word words [
			; deletion
			repeat n ln: length? word [
				insert tail result head remove at copy word n
			]
			; transposition
			repeat n ln - 1 [
				insert tail result head change change at copy word n pick word n + 1 pick word n
			]
			foreach ch "abcdefghijklmnopqrstuvwxyz" [
				; alteration
				repeat n ln [
					poke w: copy word n ch
					insert tail result w
				]
				; insertion
				repeat n ln + 1 [
					insert tail result head insert at copy word n ch
				]
			]
		]
		result
	]

	lookup-word: make function! [
		word [string!]
		/local result
	] [
		any [
			not empty? result: intersect locale*/dict make hash! word: reduce [word]
			not empty? result: intersect locale*/dict make hash! edits word
			result: word
		]
		sort result
	]

	;
	;	--- Edit ---
	;

	insert?: true

	keymap: [
		#"^H" back-char
		#"^~" del-char
		#"^M" enter
		#"^A" all-text
		#"^C" copy-text
		#"^X" cut-text
		#"^V" paste-text
		#"^T" clear-tail
		#"^Z" undo
		#"^Y" redo
		#"^[" undo-all
		#"^S" spellcheck
		#"^/" ctrl-enter
	]

	;	Text highlight functions (but, do not reshow the face)

	hilight-text: make function! [start end] [
		view*/highlight-start: start
		view*/highlight-end: end
	]

	hilight-all: make function! [face] [
		either empty? face/text [unlight-text] [
			view*/highlight-start: head face/text
			view*/highlight-end: tail face/text
		]
	]

	unlight-text: make function! [] [
		view*/highlight-start: view*/highlight-end: none
	]

	hilight?: make function! [] [
		all [
			object? view*/focal-face
			string? view*/highlight-start
			string? view*/highlight-end
			not zero? offset? view*/highlight-end view*/highlight-start
		]
	]

	hilight-range?: make function! [/local start end] [
		start: view*/highlight-start
		end: view*/highlight-end
		if negative? offset? start end [start: end end: view*/highlight-start]
		reduce [start end]
	]

	;	Text focus functions

	tabbed?: make function! [
		face [object!]
	] [
		all [
			face/show?
			find behaviors/tabbed face/type
			face
		]
	]

	group?: make function! [
		face [object!]
	] [
		all [
			face/show?
			in face 'group
			get in face 'group
		]
	]

	child?: make function! [
		face [object!]
	] [
		any [
			attempt [all [face/parent-face/parent-face/type = 'tab-panel face/parent-face/parent-face]]
			all [in face/parent-face 'group face/parent-face]
		]
	]

	unfocus: make function! [/local face] [
		if face: view*/focal-face [
			if all [
				face/type <> 'face
				face/action
				get in face/action 'on-unfocus
			] [
				unless face/action/on-unfocus face [return false]
			]
			all [
				view*/caret
				in face 'caret
				face/caret: index? view*/caret
			]
			switch face/type [
				button [face/feel/over face off 0x0]
				drop-list [face/feel/over face off 0x0]
;				table [face/select-row none]
;				text-list [face/select-row none]
;				tree [face/select-row none]
;				face [
;					all [face/parent-face/parent-face/type = 'table face/parent-face/parent-face/select-row none]
;				]
			]
		]
		view*/focal-face: view*/caret: none
		unlight-text
		all [face show face]
		true
	]

	;	Copy and delete functions

	copy-selected-text: make function! [/local start end] [
		if hilight? [
			set [start end] hilight-range?
			write clipboard:// copy/part start end
			true
		] ; else return false
	]

	delete-selected-text: make function! [/local start end] [
		if hilight? [
			set [start end] hilight-range?
			remove/part start end
			view*/caret: start
			view*/focal-face/line-list: none
			unlight-text
			true
		] ; else return false
	]

	cut-text: make function! [] [
		undo-add face
		copy-selected-text face
		delete-selected-text
	]

	paste-text: make function! [] [
		undo-add face
		delete-selected-text
		face/line-list: none
		view*/caret: insert view*/caret read clipboard://
	]

	;	Undo / Redo functions

	undo-max: 20 ; max number of undo levels, none = unlimited

	undo-add: make function! [face] [
		if in face 'undo [
			insert clear face/undo at copy face/text index? view*/caret
			if all [undo-max undo-max < length? head face/undo] [remove head face/undo]
			face/undo: tail face/undo
		]
	]

	undo-get: make function! [face] [
		face/text: head view*/caret: first face/undo
		face/line-list: none
		remove face/undo
	]

	;	Cursor movement functions

	word-limits: make bitset! " ^/^-^m/[](){}^""
	word-limits: reduce [word-limits complement word-limits]

	current-word: make function! [str [string!] /local s ns] [
		set [s] word-limits
		s: any [all [s: find/reverse str s next s] head str]
		set [ns] word-limits
		ns: any [find str ns tail str]
		;	hilight word
		hilight-text s ns
		show view*/focal-face
	]

	next-word: make function! [str /local s ns] [
		set [s ns] word-limits
		any [all [s: find str s find s ns] tail str]
	]

	back-word: make function! [str /local s ns] [
		set [s ns] word-limits
		any [all [ns: find/reverse str ns ns: find/reverse ns s next ns] head str]
	]

	end-of-line: make function! [str] [
		any [find str "^/" tail str]
	]

	beg-of-line: make function! [str /local nstr] [
		either nstr: find/reverse str "^/" [next nstr] [head str]
	]

	next-field: make function! [face /wrap /local f g] [
		foreach sibling either wrap [face/parent-face/pane] [find/tail face/parent-face/pane face] [
			case [
				g: group? sibling [
					return next-field/wrap first g
				]
				sibling/type = 'face [
					all [
						find [table text-list tree] face/parent-face/parent-face/type
						return next-field face/parent-face/parent-face
					]
				]
				tabbed? sibling [return sibling]
			]
		]
		unless all [
			f: child? face
			face <> f
			return next-field f
		] [
			next-field/wrap face
		]
	]

	back-field: make function! [face /wrap /local f siblings] [
		siblings: reverse compose [(face/parent-face/pane)]
		unless wrap [siblings: find/tail siblings face]
		foreach sibling siblings [
			case [
				g: group? sibling [
					return back-field/wrap first g
				]
				sibling/type = 'face [
					all [
						find [table text-list tree] face/parent-face/parent-face/type
						return back-field face/parent-face/parent-face
					]
				]
				tabbed? sibling [return sibling]
			]
		]
		unless all [
			f: child? face
			face <> f
			return back-field f
		] [
			back-field/wrap face
		]
	]

	keys-to-insert: make bitset! #{01000000FFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}

	insert-char: make function! [face char] [
		delete-selected-text
		unless any [insert? tail? view*/caret "^/" = first view*/caret] [remove view*/caret] ; AGT #25
		insert view*/caret char
		view*/caret: next view*/caret
	]

	move: make function! [event ctrl plain] [
		either event/shift [
			any [view*/highlight-start view*/highlight-start: view*/caret]
		] [unlight-text]
		view*/caret: either event/control ctrl plain
		if event/shift [
			either view*/caret = view*/highlight-start [unlight-text] [view*/highlight-end: view*/caret]
		]
	]

	move-y: make function! [face delta /local pos tmp tmp2] [
		tmp: offset-to-caret face 0x2 + delta + pos: caret-to-offset face view*/caret
		tmp2: caret-to-offset face tmp
		either tmp2/y <> pos/y [tmp] [view*/caret]
	]

	edit-text: make function! [
		face event
		/local key edge para caret scroll page-up page-down face-size
	] [
		face-size: face/size - either face/edge [2 * face/edge/size] [0]
		key: event/key
		if char? key [
			either find keys-to-insert key [
				undo-add face
				insert-char face key
			] [key: select keymap key]
		]
		if word? key [
			page-up: [move-y face face-size - sizes/font-height - sizes/font-height * 0x-1]
			page-down: [move-y face face-size - sizes/font-height * 0x1]
			switch key [
				left [move event [back-word view*/caret] [back view*/caret]]
				right [move event [next-word view*/caret] [next view*/caret]]
				up [move event page-up [move-y face sizes/font-height * 0x-1]]
				down [move event page-down [move-y face sizes/font-height * 0x1]]
				page-up [move event [head view*/caret] page-up]
				page-down [move event [tail view*/caret] page-down]
				home [move event [head view*/caret] [beg-of-line view*/caret]]
				end [move event [tail view*/caret] [end-of-line view*/caret]]
				insert [either event/shift [paste-text] [insert?: complement insert?]]
				back-char [
					undo-add face
					any [
						delete-selected-text
						head? view*/caret
						either event/control [
							tmp: view*/caret
							remove/part view*/caret: back-word tmp tmp
						] [remove view*/caret: back view*/caret]
					]
				]
				del-char [
					undo-add face
					either event/shift [unless face/type = 'password [cut-text]] [;	shift+Del cut
						any [
							delete-selected-text
							tail? view*/caret
							either event/control [
								remove/part view*/caret back next-word view*/caret
								if tail? next view*/caret [remove back tail view*/caret]
							] [remove view*/caret]
						]
					]
				]
				enter [
					either find behaviors/action-on-enter face/type [
						all [face/type = 'spinner face/action/on-unfocus face]
						set-focus face
						face/action/on-click face
					] [
						undo-add face
						insert-char face "^/"
					]
				]
				ctrl-enter [undo-add face insert-char face tab]
				all-text [hilight-all face]
				copy-text [unless face/type = 'password [copy-selected-text face unlight-text]]
				cut-text [unless face/type = 'password [cut-text]]
				paste-text [paste-text]
				clear-tail [
					undo-add face
					remove/part view*/caret end-of-line view*/caret
				]
				undo [
					if all [in face 'undo not head? face/undo] [
						insert face/undo at copy face/text index? view*/caret
						face/undo: back face/undo
						undo-get face
					]
				]
				redo [
					if all [in face 'undo not tail? face/undo] [
						face/undo: insert face/undo at copy face/text index? view*/caret
						undo-get face
					]
				]
				undo-all [
					if in face 'esc [
						clear face/text
						all [in face 'undo clear face/undo]
						all [string? face/esc insert face/text face/esc]
						view*/caret: tail face/text
					]
				]
				spellcheck [
					request-spellcheck face
				]
			]
		]
		;	scroll to keep caret visible
		edge: face/edge
		para: face/para
		scroll: face/para/scroll

		error? try [
			caret: caret-to-offset face view*/caret

			if caret/y < (edge/size/y + para/origin/y + para/indent/y) [; above top visible row ?
				scroll/y: round/to scroll/y - caret/y sizes/font-height ; scroll to make caret visible
			]

			if caret/y > (face-size/y - sizes/font-height) [; below bottom visible row ? (face-size takes edge into account)
				scroll/y: round/to (scroll/y + ((face-size/y - sizes/font-height) - caret/y)) sizes/font-height
			]

			unless para/wrap? [
				if caret/x < (edge/size/x + para/origin/x + para/indent/x) [
					scroll/x: scroll/x - caret/x + (edge/size/x + para/origin/x + para/indent/x)
				]
				if caret/x > (face-size/x - para/margin/x) [
					scroll/x: scroll/x + (face-size/x - para/margin/x - caret/x)
				]
			]

			if scroll <> face/para/scroll [
				face/para/scroll: scroll
				if face/type = 'area [face/key-scroll?: true]
			]
		]
		show face
	]

	feel: make object! [
		redraw: detect: over: none
		engage: make function! [face act event /local txt] [
			switch act [
				key [
					unless all [get in face/action 'on-key not face/action/on-key face event] [
						txt: copy face/text
						edit-text face event
						all [
							get in face/action 'on-edit
							strict-not-equal? txt face/text
							face/action/on-edit face
						]
					]
				]
				down [
					either event/double-click [
						all [view*/caret not empty? view*/caret current-word view*/caret]
					] [
						either face = view*/focal-face [
							unlight-text
							view*/caret: offset-to-caret face event/offset
							show face
						] [
							caret: offset-to-caret face event/offset
							set-focus face
						]
					]
				]
				over [
					unless view*/caret = offset-to-caret face event/offset [
						unless view*/highlight-start [view*/highlight-start: view*/caret]
						view*/highlight-end: view*/caret: offset-to-caret face event/offset
						show face
					]
				]
				alt-up [face/action/on-alt-click face]
				scroll-line [face/action/on-scroll face event/offset]
				scroll-page [face/action/on-scroll/page face event/offset]
			]
		]
	]
]